home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / puma.lha / puma / src / puma.mi < prev    next >
Text File  |  1992-09-25  |  14KB  |  457 lines
  1. (* Ich, Doktor Josef Grosch, Informatiker, April 1991 *)
  2.  
  3. MODULE puma;
  4.  
  5. FROM System    IMPORT GetArgCount, GetArgument, System, Exit;
  6. FROM Memory    IMPORT MemoryUsed;
  7. FROM IO        IMPORT StdOutput, StdError, WriteOpen, WriteClose, CloseIO,
  8.             WriteI, WriteS, WriteNl,
  9.             tFile, ReadOpen, ReadClose, EndOfFile, ReadNl;
  10. FROM Strings    IMPORT tString, AssignEmpty, Assign, Append, Concatenate,
  11.             ReadL, WriteL, ArrayToString, StringToArray;
  12. FROM Idents    IMPORT tIdent, MakeIdent, GetString, WriteIdent;
  13. FROM Sets    IMPORT tSet, MakeSet, ReleaseSet, Include, Exclude, IsEmpty,
  14.             Extract, Complement, Union, IsElement;
  15. FROM Errors    IMPORT StoreMessages, WriteMessages;
  16. FROM Scanner    IMPORT ScanTabName, BeginFile, ErrorI;
  17. FROM Parser    IMPORT Parser, ParsTabName;
  18. FROM Tree    IMPORT NoTree, tTree, TreeRoot, HeapUsed, Options, SourceFile, f,
  19.             WI, mNoClass, TreeName, ErrorCount, Class, Child, Attribute, 
  20.             ActionPart, NoClass, Test, Dummy, ForallClasses, ForallAttributes,
  21.             QueryTree;
  22. FROM Tree2    IMPORT GetTree2;
  23. FROM Semantics    IMPORT Semantics, TypeCount, TypeNames, UserTypes, RemoveTreeTypes;
  24. FROM Optimize    IMPORT Optimize, RuleProperties;
  25. FROM Mod    IMPORT DefMod, ImplMod, MacroMod;
  26. FROM C        IMPORT DefC, ImplC, MacroC;
  27.  
  28. CONST
  29.    DefExtMc    = ".md"    ;    (* file extensions for Modula (mc)    *)
  30.    ImpExtMc    = ".mi"    ;
  31.    LisExtMc    = ".imp";
  32.  
  33.    DefExtC    = ".h"    ;    (* file extensions for C        *)
  34.    ImpExtC    = ".c"    ;
  35.  
  36. VAR
  37.    PumaLib    ,
  38.    TrafoFile    ,
  39.    String    ,
  40.    PathS    : tString;
  41.    Argument    ,
  42.    PathA    : ARRAY [0..255] OF CHAR;
  43.    i, j, n    : SHORTCARD;
  44.    ch        : CHAR;
  45.    Node        : tTree;
  46.  
  47. PROCEDURE SmartOpen (FileName: tString): tFile;
  48.    VAR PathS: tString;
  49.    BEGIN
  50.       IF IsElement (ORD ('7'), Options) THEN
  51.      ArrayToString    ("yy", PathS);
  52.      Concatenate    (PathS, FileName);
  53.      Append        (PathS, 0C);
  54.      StringToArray    (PathS, PathA);
  55.       ELSE
  56.      Append        (FileName, 0C);
  57.      StringToArray    (FileName, PathA);
  58.       END;
  59.       RETURN WriteOpen    (PathA);
  60.    END SmartOpen;
  61.  
  62. PROCEDURE SmartClose (FileName: tString; f: tFile);
  63.    VAR PathS: tString;
  64.    BEGIN
  65.       WriteClose    (f);
  66.       IF IsElement (ORD ('7'), Options) THEN
  67.      ArrayToString    ("gmdupd ", PathS);
  68.      Concatenate    (PathS, FileName);
  69.      ArrayToString    (" yy", String);
  70.      Concatenate    (PathS, String);
  71.      Concatenate    (PathS, FileName);
  72.      Append        (PathS, 0C);
  73.      StringToArray    (PathS, PathA);
  74.      n := System    (PathA);
  75.       END;
  76.    END SmartClose;
  77.  
  78. PROCEDURE GenerateMacros;
  79.    VAR TypeTabFile    : tFile;
  80.    VAR s        : tString;
  81.    VAR i        : tIdent;
  82.    VAR j        : INTEGER;
  83.    BEGIN
  84.    IF IsElement (ORD ('c'), Options) THEN
  85.       ArrayToString    ("TypeTab.c", String);    (* name of type table for C *)
  86.    ELSE
  87.       ArrayToString    ("TypeTab.m", String);    (* name of type table for Modula *)
  88.    END;
  89.       Assign        (PathS, PumaLib);
  90.       Concatenate     (PathS, String);
  91.       Append        (PathS, 0C);
  92.       StringToArray    (PathS, PathA);
  93.       TypeTabFile := ReadOpen (PathA);
  94.  
  95.       ArrayToString    ("yy" , PathS);        (* name of macro file *)
  96.       GetString        (TreeRoot^.Spec.TrafoName, String);
  97.       Concatenate    (PathS, String);
  98.       ArrayToString    (".w", String);
  99.       Concatenate    (PathS, String);
  100.       Append        (PathS, 0C);
  101.       StringToArray    (PathS, PathA);
  102.       f := WriteOpen (PathA);
  103.  
  104.       WHILE NOT EndOfFile (TypeTabFile) DO
  105.      ReadL (TypeTabFile, s);
  106.      i := MakeIdent (s);
  107.      IF (i <= TypeCount) AND IsElement (i, TypeNames) THEN
  108.         Exclude (TypeNames, i);
  109.         WriteS (f, "# ifndef begin"); WI (i); WriteNl (f);
  110.         ReadL (TypeTabFile, s); WriteL (f, s);
  111.         WriteS (f, "# endif"); WriteNl (f);
  112.         FOR j := 2 TO 7 DO ReadNl (TypeTabFile); END;
  113.         WriteS (f, "# ifndef equal"); WI (i); WriteNl (f);
  114.         ReadL (TypeTabFile, s); WriteL (f, s);
  115.         WriteS (f, "# endif"); WriteNl (f);
  116.      ELSE
  117.         FOR j := 1 TO 8 DO ReadNl (TypeTabFile); END;
  118.      END;
  119.       END;
  120.       ReadClose (TypeTabFile);
  121.       RemoveTreeTypes (TreeRoot);
  122.  
  123.       WHILE NOT IsEmpty (TypeNames) DO
  124.      i := Extract (TypeNames);
  125.      Include (UserTypes, i);
  126.    IF IsElement (ORD ('c'), Options) THEN
  127.      WriteS (f, "# ifndef begin"); WI (i); WriteNl (f);
  128.      WriteS (f, "# define begin"); WI (i); WriteS (f, "(a)"); WriteNl (f);
  129.      WriteS (f, "# endif"); WriteNl (f);
  130.      WriteS (f, "# ifndef equal"); WI (i); WriteNl (f);
  131.      WriteS (f, "# define equal"); WI (i); WriteS (f, "(a, b)    memcmp ((char *) & a, (char *) & b, sizeof (a)) == 0"); WriteNl (f);
  132.      WriteS (f, "# endif"); WriteNl (f);
  133.    ELSE
  134.      WriteS (f, "# ifndef begin"); WI (i); WriteNl (f);
  135.      WriteS (f, "# define begin"); WI (i); WriteS (f, "(a)"); WriteNl (f);
  136.      WriteS (f, "# endif"); WriteNl (f);
  137.      WriteS (f, "# ifndef equal"); WI (i); WriteNl (f);
  138.      WriteS (f, "# define equal"); WI (i); WriteS (f, "(a, b)    yyIsEqual (a, b)"); WriteNl (f);
  139.      WriteS (f, "# endif"); WriteNl (f);
  140.    END;
  141.       END;
  142.  
  143.    IF IsElement (ORD ('c'), Options) THEN
  144.       MacroC (TreeRoot);
  145.    ELSE
  146.       MacroMod (TreeRoot);
  147.    END;
  148.  
  149.       WriteClose (f);
  150.    END GenerateMacros;
  151.  
  152. VAR IndentLevel: INTEGER;
  153.  
  154. PROCEDURE WriteClass (t: tTree);
  155.    VAR i: INTEGER;
  156.    BEGIN
  157.       CASE t^.Kind OF
  158.       | Class    : WITH t^.Class DO
  159.         FOR i := 1 TO IndentLevel DO
  160.            WriteS    (StdOutput, "   ");
  161.         END;
  162.         WriteIdent    (StdOutput, Name);
  163.         WriteS    (StdOutput, "    =");
  164.         WriteClass    (Attributes);
  165.         IF Extensions^.Kind # NoClass THEN
  166.            WriteS    (StdOutput, " <");
  167.            WriteNl    (StdOutput);
  168.            INC (IndentLevel);
  169.            WriteClass (Extensions);
  170.            DEC (IndentLevel);
  171.            FOR i := 1 TO IndentLevel DO
  172.           WriteS (StdOutput, "   ");
  173.            END;
  174.            WriteS    (StdOutput, ">");
  175.         END;
  176.         WriteS    (StdOutput, " .");
  177.         WriteNl    (StdOutput);
  178.         WriteClass    (Next);
  179.      END;
  180.       | Child    : WITH t^.Child DO
  181.         WriteS    (StdOutput, " ");
  182.         WriteIdent    (StdOutput, Name);
  183.         WriteS    (StdOutput, ": ");
  184.         WriteIdent    (StdOutput, Type);
  185.         WriteClass    (Next);
  186.      END;
  187.       | Attribute    : WITH t^.Attribute DO
  188.      IF ({Test, Dummy} * Properties) = {} THEN
  189.         WriteS    (StdOutput, " [");
  190.         WriteIdent    (StdOutput, Name);
  191.         WriteS    (StdOutput, ": ");
  192.         WriteIdent    (StdOutput, Type);
  193.         WriteS    (StdOutput, "]");
  194.      END;
  195.         WriteClass    (Next);
  196.      END;
  197.       | ActionPart    : WITH t^.ActionPart DO
  198.         WriteClass    (Next);
  199.      END;
  200.       ELSE
  201.       END;
  202.    END WriteClass;
  203.  
  204. VAR IsFirst: BOOLEAN;
  205.  
  206. PROCEDURE WritePattern (t: tTree);
  207.    BEGIN
  208.       CASE t^.Kind OF
  209.       | Class    : WITH t^.Class DO
  210.         WriteIdent    (StdOutput, Name);
  211.         WriteS    (StdOutput, " (");
  212.         IsFirst := TRUE;
  213.         ForallAttributes (t, WritePattern);
  214.         WriteS    (StdOutput, ")");
  215.         WriteNl    (StdOutput);
  216.      END;
  217.       | Child    : WITH t^.Child DO
  218.         IF IsFirst THEN
  219.            IsFirst := FALSE;
  220.         ELSE
  221.            WriteS    (StdOutput, ", ");
  222.         END;
  223.         WriteIdent    (StdOutput, Name);
  224.         WriteS    (StdOutput, ":");
  225.         WriteIdent    (StdOutput, Type);
  226.      END;
  227.       | Attribute    : WITH t^.Attribute DO
  228.      IF ({Test, Dummy} * Properties) = {} THEN
  229.         IF IsFirst THEN
  230.            IsFirst := FALSE;
  231.         ELSE
  232.            WriteS    (StdOutput, ", ");
  233.         END;
  234.         WriteIdent    (StdOutput, Name);
  235.      END;
  236.      END;
  237.       ELSE
  238.       END;
  239.    END WritePattern;
  240.  
  241. BEGIN
  242.    IndentLevel := 0;
  243.    AssignEmpty (PumaLib);
  244.    SourceFile [0] := 0C;
  245.    n := GetArgCount () - 1;
  246.  
  247.    FOR i := 1 TO n DO
  248.       GetArgument (i, Argument);
  249.       IF Argument [0] = '-' THEN 
  250.      IF Argument [1] = 'l' THEN 
  251.         AssignEmpty (PumaLib);
  252.         j := 2;
  253.         LOOP
  254.            ch := Argument [j];
  255.            IF ch = 0C THEN EXIT; END;
  256.            Append (PumaLib, ch);
  257.            INC (j);
  258.         END;
  259.         Append (PumaLib, '/');
  260.         DEC (n);
  261.      ELSE
  262.         j := 0;
  263.         LOOP
  264.            INC (j);
  265.            ch := Argument [j];
  266.            IF ch = 0C THEN
  267.           EXIT;
  268.            ELSIF ch = '?' THEN
  269.           Include (Options, ORD ('h'));
  270.            ELSE
  271.           Include (Options, ORD (ch));
  272.            END;
  273.         END;
  274.      END;
  275.       ELSIF Argument [0] = '?' THEN 
  276.      Include (Options, ORD ('h'));
  277.       ELSE
  278.      j := 0;
  279.      REPEAT
  280.             ch := Argument [j];
  281.         SourceFile [j] := ch;
  282.         INC (j);
  283.      UNTIL ch = 0C;
  284.      DEC (n);
  285.       END;
  286.    END;
  287.  
  288.    IF n < 1 THEN                (* {} -> a        *)
  289.       Include (Options, ORD ('a'));
  290.    END;
  291.  
  292.    IF IsElement (ORD ('a'), Options) THEN    (* a -> {d, i}        *)
  293.       Include (Options, ORD ('d'));
  294.       Include (Options, ORD ('i'));
  295.    END;
  296.  
  297.    IF IsElement (ORD ('h'), Options) THEN
  298.       Exclude (Options, ORD ('h'));
  299.       f := StdOutput;
  300.       WriteNl (f);
  301.       WriteS (f, "usage: puma [-options] [-ldir] [file]"); WriteNl (f);
  302.       WriteNl (f);
  303.       WriteS (f, " a generate all, same as -di (default)"); WriteNl (f);
  304.       WriteS (f, " d generate definition     module"); WriteNl (f);
  305.       WriteS (f, " i generate implementation module"); WriteNl (f);
  306.       WriteS (f, " s suppress warnings"); WriteNl (f);
  307.       WriteS (f, " m use procedure MakeTREE to construct nodes (default is inline code)"); WriteNl (f);
  308.       WriteS (f, " p allow node constructors without parentheses"); WriteNl (f);
  309.       WriteS (f, " f signal a runtime error if none of the rules of a procedure matches"); WriteNl (f);
  310.       WriteS (f, " k allow non-linear patterns"); WriteNl (f);
  311.       WriteS (f, " n check parameters for NoTREE (NIL) and treat as failure (tg compatibility)"); WriteNl (f);
  312.       WriteS (f, " w surround actions by WITH statements (tg compatibility)"); WriteNl (f);
  313.       WriteS (f, " e treat undefined names as error"); WriteNl (f);
  314.       WriteS (f, " v treat undefined names as warning"); WriteNl (f);
  315.       WriteS (f, " o list undefined names on standard output"); WriteNl (f);
  316.       WriteS (f, " t print tree definitions"); WriteNl (f);
  317.       WriteS (f, " r print patterns"); WriteNl (f);
  318.       WriteS (f, " q browse internal data structure"); WriteNl (f);
  319.       WriteS (f, " 6 generate # line directives"); WriteNl (f);
  320.       WriteS (f, " 7 touch output files only if necessary"); WriteNl (f);
  321.       WriteS (f, " 8 report storage consumption"); WriteNl (f);
  322.       WriteS (f, " c generate C code (default is Modula-2)"); WriteNl (f);
  323.       WriteS (f, " h print help information"); WriteNl (f);
  324.       WriteS (f, " -ldir specify the directory dir where puma finds its tables"); WriteNl (f);
  325.       WriteNl (f);
  326.    END;
  327.  
  328.    IF IsEmpty (Options) THEN CloseIO; HALT; END;
  329.  
  330.       ArrayToString    (ScanTabName, String);    (* name of scanner table *)
  331.       Assign        (PathS, PumaLib);
  332.       Concatenate    (PathS, String);
  333.       Append        (PathS, 0C);
  334.       StringToArray    (PathS, ScanTabName);
  335.  
  336.       ArrayToString    (ParsTabName, String);    (* name of parser table *)
  337.       Assign        (PathS, PumaLib);
  338.       Concatenate    (PathS, String);
  339.       Append        (PathS, 0C);
  340.       StringToArray    (PathS, ParsTabName);
  341.  
  342.       StoreMessages (TRUE);
  343.       IF SourceFile [0] # 0C THEN BeginFile (SourceFile); END;
  344.       INC (ErrorCount, Parser ());
  345.  
  346.       Node := TreeRoot^.Spec.TreeNames;
  347.       WHILE Node^.Kind = TreeName DO
  348.      GetString    (Node^.TreeName.Name, PathS);
  349.      ArrayToString    (".TS", String);
  350.      Concatenate    (PathS, String);
  351.      Append        (PathS, 0C);
  352.      StringToArray    (PathS, PathA);
  353.      f := ReadOpen    (PathA);
  354.      IF f >= 0 THEN
  355.         ReadL (f, String); Node^.TreeName.Name := MakeIdent (String);
  356.         Node^.TreeName.Classes := GetTree2 (f);
  357.         ReadClose    (f);
  358.    IF IsElement (ORD ('t'), Options) THEN
  359.         WriteS (StdOutput, "Tree Definition: "); WriteIdent (StdOutput, Node^.TreeName.Name);
  360.         WriteNl (StdOutput);
  361.         WriteS (StdOutput, "----------------"); WriteNl (StdOutput);
  362.         WriteNl (StdOutput);
  363.         WriteClass (Node^.TreeName.Classes);
  364.         WriteNl (StdOutput);
  365.    END;
  366.    IF IsElement (ORD ('r'), Options) THEN
  367.         WriteS (StdOutput, "Patterns: "); WriteIdent (StdOutput, Node^.TreeName.Name);
  368.         WriteNl (StdOutput);
  369.         WriteS (StdOutput, "---------"); WriteNl (StdOutput);
  370.         WriteNl (StdOutput);
  371.         ForallClasses (Node^.TreeName.Classes, WritePattern);
  372.         WriteNl (StdOutput);
  373.    END;
  374.      ELSE
  375.         Node^.TreeName.Classes := mNoClass ();
  376.         ErrorI ("cannot read view file", Node^.TreeName.Pos, Node^.TreeName.Name);
  377.      END;
  378.      Node := Node^.TreeName.Next;
  379.       END;
  380.  
  381.       Semantics    (TreeRoot);
  382.    IF IsElement (ORD ('b'), Options) THEN
  383.       RuleProperties    (TreeRoot);
  384.    ELSE
  385.       Optimize        (TreeRoot);
  386.    END;
  387.  
  388.       WriteMessages (StdError);
  389.  
  390.    IF IsElement (ORD ('q'), Options) THEN
  391.       QueryTree        (TreeRoot);
  392.    END;
  393.  
  394.       IF ErrorCount > 0 THEN CloseIO; Exit (1); END;
  395.       GenerateMacros;
  396.  
  397.    IF IsElement (ORD ('d'), Options) THEN
  398.       GetString        (TreeRoot^.Spec.TrafoName, PathS);
  399.    IF IsElement (ORD ('c'), Options) THEN
  400.       ArrayToString    (DefExtC , String);
  401.    ELSE
  402.       ArrayToString    (DefExtMc, String);
  403.    END;
  404.       Concatenate    (PathS, String);
  405.       f := SmartOpen    (PathS);
  406.    IF IsElement (ORD ('c'), Options) THEN
  407.       DefC        (TreeRoot);
  408.    ELSE
  409.       DefMod        (TreeRoot);
  410.    END;
  411.       SmartClose    (PathS, f);
  412.    END;
  413.  
  414.    IF IsElement (ORD ('i'), Options) THEN
  415.       GetString        (TreeRoot^.Spec.TrafoName, PathS);
  416.    IF IsElement (ORD ('c'), Options) THEN
  417.       ArrayToString    (ImpExtC , String);
  418.    ELSE
  419.       ArrayToString    (ImpExtMc, String);
  420.    END;
  421.       Concatenate    (PathS, String);
  422.       Assign        (TrafoFile, PathS);
  423.       f := SmartOpen    (PathS);
  424.    IF IsElement (ORD ('c'), Options) THEN
  425.       ImplC        (TreeRoot);
  426.    ELSE
  427.       ImplMod        (TreeRoot);
  428.    END;
  429.       SmartClose    (PathS, f);
  430.  
  431.    IF NOT IsElement (ORD ('c'), Options) THEN
  432.       ArrayToString    ("gmdcpp ", PathS);        (* call cpp *)
  433.       Concatenate    (PathS, TrafoFile);
  434.       Append        (PathS, 0C);
  435.       StringToArray    (PathS, PathA);
  436.       n := System    (PathA);
  437.  
  438.       ArrayToString    ("gmdrm yy" , PathS);        (* name of macro file *)
  439.       GetString        (TreeRoot^.Spec.TrafoName, String);
  440.       Concatenate    (PathS, String);
  441.       ArrayToString    (".w", String);
  442.       Concatenate    (PathS, String);
  443.       Append        (PathS, 0C);
  444.       StringToArray    (PathS, PathA);
  445.       n := System    (PathA);
  446.    END;
  447.    END;
  448.  
  449.    IF IsElement (ORD ('8'), Options) THEN
  450.       WriteNl (StdError);
  451.       WriteS  (StdError, "Memory"); WriteI (StdError, MemoryUsed, 8);
  452.       WriteS  (StdError, "  Heap"); WriteI (StdError, HeapUsed  , 8);
  453.       WriteNl (StdError);
  454.    END;
  455.    CloseIO; Exit (0);
  456. END puma.
  457.